﻿Option Explicit On
Option Strict On

Imports System
Imports System.IO
Imports System.IO.Ports
Imports System.Runtime.InteropServices
Imports System.Text
Imports Microsoft.Win32.SafeHandles

Public Class PortFixer
    Implements IDisposable

#Region " Private Members "

    Private Const DcbFlagAbortOnError As Integer = 14
    Private Const CommStateRetries As Integer = 10
    Private m_Handle As SafeFileHandle

#End Region

#Region " API Imports "

    <DllImport("kernel32.dll", CharSet:=CharSet.Auto, SetLastError:=True)> _
    Private Shared Function FormatMessage(dwFlags As Integer, lpSource As HandleRef, dwMessageId As Integer, dwLanguageId As Integer, lpBuffer As StringBuilder, nSize As Integer, arguments As IntPtr) As Integer
    End Function

    <DllImport("kernel32.dll", CharSet:=CharSet.Auto, SetLastError:=True)> _
    Private Shared Function GetCommState(hFile As SafeFileHandle, ByRef lpDcb As Dcb) As Boolean
    End Function

    <DllImport("kernel32.dll", CharSet:=CharSet.Auto, SetLastError:=True)> _
    Private Shared Function SetCommState(hFile As SafeFileHandle, ByRef lpDcb As Dcb) As Boolean
    End Function

    <DllImport("kernel32.dll", CharSet:=CharSet.Auto, SetLastError:=True)> _
    Private Shared Function ClearCommError(hFile As SafeFileHandle, ByRef lpErrors As Integer, ByRef lpStat As Comstat) As Boolean
    End Function

    <DllImport("kernel32.dll", CharSet:=CharSet.Auto, SetLastError:=True)> _
    Private Shared Function CreateFile(lpFileName As String, dwDesiredAccess As Integer, dwShareMode As Integer, securityAttrs As IntPtr, dwCreationDisposition As Integer, dwFlagsAndAttributes As Integer, hTemplateFile As IntPtr) As SafeFileHandle
    End Function

    <DllImport("kernel32.dll", SetLastError:=True)> _
    Private Shared Function GetFileType(hFile As SafeFileHandle) As Integer
    End Function

#End Region

#Region " API Structures "

    <StructLayout(LayoutKind.Sequential)> _
    Private Structure Comstat
        Public ReadOnly Flags As UInteger
        Public ReadOnly cbInQue As UInteger
        Public ReadOnly cbOutQue As UInteger
    End Structure

    <StructLayout(LayoutKind.Sequential)> _
    Private Structure Dcb
        Public ReadOnly DCBlength As UInteger
        Public ReadOnly BaudRate As UInteger
        Public Flags As UInteger
        Public ReadOnly wReserved As UShort
        Public ReadOnly XonLim As UShort
        Public ReadOnly XoffLim As UShort
        Public ReadOnly ByteSize As Byte
        Public ReadOnly Parity As Byte
        Public ReadOnly StopBits As Byte
        Public ReadOnly XonChar As Byte
        Public ReadOnly XoffChar As Byte
        Public ReadOnly ErrorChar As Byte
        Public ReadOnly EofChar As Byte
        Public ReadOnly EvtChar As Byte
        Public ReadOnly wReserved1 As UShort
    End Structure

#End Region

    ''' <summary>
    ''' Constructor
    ''' </summary>
    ''' <param name="portName"></param>
    ''' <remarks></remarks>
    Private Sub New(portName As String)

        Const dwFlagsAndAttributes As Integer = &H40000000
        Const dwAccess As Integer = &HC0000000

        If String.IsNullOrEmpty(portName) Or Not portName.StartsWith("COM", StringComparison.OrdinalIgnoreCase) Then
            Throw New ArgumentException("Invalid Serial Port", "portName")
        End If
        Dim hFile As SafeFileHandle = CreateFile("\\.\" & portName, dwAccess, 0, IntPtr.Zero, 3, dwFlagsAndAttributes, IntPtr.Zero)

        If hFile.IsInvalid Then
            WinIoError()
        End If

        Try
            Dim fileType As Integer = GetFileType(hFile)
            If Not fileType = 2 And Not fileType = 0 Then
                Throw New ArgumentException("Invalid Serial Port", "portName")
            End If
            m_Handle = hFile
            InitializeDcb()
        Catch
            hFile.Close()
            m_Handle = Nothing
            Throw
        End Try

    End Sub

    Private Sub InitializeDcb()
        Dim dcb As Dcb = New Dcb()
        GetCommStateNative(dcb)
        dcb.Flags = dcb.Flags And Not (Convert.ToUInt32(1) << DcbFlagAbortOnError)
        SetCommStateNative(dcb)
    End Sub

    Private Shared Function GetMessage(errorCode As Integer) As String
        Dim lpBuffer As StringBuilder = New StringBuilder(&H200)
        If Not FormatMessage(&H3200, New HandleRef(Nothing, IntPtr.Zero), errorCode, 0, lpBuffer, lpBuffer.Capacity, IntPtr.Zero) = 0 Then
            Return lpBuffer.ToString()
        End If
        Return "Unknown Error"
    End Function

    Private Shared Function MakeHrFromErrorCode(errorCode As Integer) As Integer
        Return (&H80070000 Or errorCode)
    End Function

    Private Shared Sub WinIoError()
        Dim errorCode As Integer = Marshal.GetLastWin32Error()
        Throw New IOException(GetMessage(errorCode), MakeHrFromErrorCode(errorCode))
    End Sub

    Private Sub GetCommStateNative(ByRef lpDcb As Dcb)
        Dim commErrors As Integer = 0
        Dim comStat As Comstat = New Comstat()

        For i As Integer = 0 To CommStateRetries - 1
            If Not ClearCommError(m_Handle, commErrors, comStat) Then
                WinIoError()
            End If
            If GetCommState(m_Handle, lpDcb) Then
                Exit For
            End If
            If i = CommStateRetries - 1 Then
                WinIoError()
            End If
        Next
    End Sub

    Private Sub SetCommStateNative(ByRef lpDcb As Dcb)
        Dim commErrors As Integer = 0
        Dim comStat As Comstat = New Comstat()

        For i As Integer = 0 To CommStateRetries - 1
            If Not ClearCommError(m_Handle, commErrors, comStat) Then
                WinIoError()
            End If
            If SetCommState(m_Handle, lpDcb) Then
                Exit For
            End If
            If i = CommStateRetries - 1 Then
                WinIoError()
            End If
        Next
    End Sub

#Region " Shared Methods "

    Public Shared Sub Execute(portName As String)
        Using New PortFixer(portName)
        End Using
    End Sub

#End Region


#Region "IDisposable Support"
    Private disposedValue As Boolean ' To detect redundant calls

    ' IDisposable
    Protected Overridable Sub Dispose(disposing As Boolean)
        If Not Me.disposedValue Then
            If m_Handle IsNot Nothing Then
                m_Handle.Close()
                m_Handle = Nothing
            End If
        End If
        Me.disposedValue = True
    End Sub

    ' This code added by Visual Basic to correctly implement the disposable pattern.
    Public Sub Dispose() Implements IDisposable.Dispose
        ' Do not change this code.  Put cleanup code in Dispose(disposing As Boolean) above.
        Dispose(True)
        GC.SuppressFinalize(Me)
    End Sub
#End Region

End Class
